home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -serious- / programming / basic / mildred / mildred.lha / lha / RainDemo.lha / Rain.ascii < prev    next >
Text File  |  2000-02-28  |  14KB  |  433 lines
  1. .Demo
  2. WBStartup
  3.  
  4. DEFTYPE.w
  5. MCPU Processor
  6. Mc2pCPUmode Processor
  7.  
  8. *ScrVP._ViewPort=0
  9. IsAGA.b=True ; Defaults to AGA
  10. Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
  11.  
  12. PrefDisplayID.l=$0 ; Default ModeID (Pal:LowRes, or promotes to DoublePal:LowRes)
  13. PrefDisplayWidth.w=320 ; Default Width
  14. PrefDisplayHeight.w=240 ; Default Height
  15. PrefDisplayBuffering.b=3 ; 1..3. 1=Singlebuffered, 2=Doublebuffered, 3=Triplebuffered
  16. PrefDisplayMethod.b=1 ; 0=WritePixelArray8/WriteChunkyPixels, 1=MBlockScroll, 2=WritePixelArray(CGFX)
  17. PrefCGFXLock.b=True ; Wether when Method=1, CGFX LockBitmap will be attempted for safety and to get base address
  18. OSVersion.w=ExecVersion
  19. CGFXAvail.b=False ; Default
  20.  
  21. #DTAG_DISP=$80000000
  22. #DTAG_DIMS=$80001000
  23. #DTAG_MNTR=$80002000
  24. #DTAG_NAME=$80003000
  25. #LBMI_BASEADDRESS=$84001007
  26. #DIPF_IS_FOREIGN=$80000000
  27. #DIPF_IS_ECS=$00000010
  28. #DIPF_IS_AGA=$00010000
  29.  
  30. If Joyb(0)=0 AND Joyb(1)=0 Then Goto SkipSMR
  31.  
  32. NEWTYPE.SMode
  33.   DID.l
  34.   DWidth.l
  35.   DHeight.l
  36.   DDepth.w
  37.   DType.w
  38. End NEWTYPE
  39.  
  40. DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
  41. myhook\h_Entry=?hook
  42. MOVE.l a5,globalbase
  43. funcret.l=0
  44.  
  45. Dim SMRtags.TagItem(17)
  46. SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160 ; X coord of requester
  47. SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0 ; Y coord of requester
  48. SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300 ; Width of requester
  49. SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,400 ; Height of requester
  50. SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000 ; Default ModeID (Pal:LowRes)
  51. SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8 ; Default depth (8-bit usually)
  52. SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
  53. SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
  54. SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1 ; Default overscan type (Text)
  55. SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1 ; Info window?
  56. SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350 ; X coord of info window
  57. SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50 ; Y coord of info window
  58. SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0 ; Depth gadget? (Generally NO for chunky 8-bit)
  59. SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,0 ; Overscan gadget?
  60. SMRtags(14)\ti_Tag=#ASLSM_DoWidth,0 ; Width gadget?
  61. SMRtags(15)\ti_Tag=#ASLSM_DoHeight,0 ; Height gadget?
  62. SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook ; Address of callback hook routine
  63. SMRtags(17)\ti_Tag=#TAG_DONE,0
  64.  
  65. *sreq.SMode=0
  66. *sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
  67. ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)
  68.  
  69. If ok<>0
  70.   PrefDisplayID.l=*sreq\DID
  71.   PrefDisplayWidth.w=*sreq\DWidth
  72.   PrefDisplayHeight.w=*sreq\DHeight
  73. EndIf
  74. If (*sreq) Then FreeAslRequest_(*sreq)
  75.  
  76. Goto SkipSMR
  77.  
  78. ;*************************************************************************
  79. ; This is the statement that the hook will call.  Put the label before
  80. ; the statement you want to jump to.
  81. Runerrsoff
  82. hook_jump:
  83. Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
  84.   ; We're inside the hook, and supposedly we should be able to do whatever
  85.   ; we want.
  86.   ; Filter modeID's here
  87.   SHARED funcret.l
  88.   DEFTYPE.DisplayInfo DisInfoBuf
  89.   DEFTYPE.DimensionInfo DimInfoBuf
  90.   DEFTYPE.MonitorInfo MonInfoBuf
  91.   DEFTYPE.NameInfo NamInfoBuf
  92.   ;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
  93.   IDhandle.l=FindDisplayInfo_(modeID)
  94.   GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
  95.   GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  96.   GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
  97.   GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
  98.   ;Do tests. True=Mode is valid, False=mode is invalid.
  99.   ;See newtypes for DisplayInfo,DimensionInfo,MonitorInfo and NameInfo for things to further test
  100.   If DimInfoBuf\MaxDepth<>8
  101.     ;No true-colour modes, only 8-bit
  102.     funcret=False
  103.   Else
  104.     funcret=True
  105.   EndIf
  106. End Statement
  107.  
  108. ;**********************
  109. ; Hook
  110. Macro goto_hook
  111.   JSR `1+6
  112. End Macro
  113.  
  114. globalbase: Dc.l 0
  115.  
  116. hook: ;This hook is called by the filter hook callback from screenmode requester, per item
  117. ; Store registers
  118. MOVEM.l   d1-d7/a0-a6,-(a7) ; Not d0!
  119.  
  120. ; Put parameters into dregs ready for a statement
  121. MOVE.l    a0,d0
  122. MOVE.l    a1,d1
  123. MOVE.l    a2,d2
  124.  
  125. ; Get global variable base
  126. MOVE.l    globalbase,a5
  127.  
  128. ; Goto hook statement
  129. !goto_hook{hook_jump}
  130.  
  131. GetReg d0,funcret ; return accept/discard
  132.  
  133. ; Restore registers
  134. MOVEM.l   (a7)+,d1-d7/a0-a6 ; Not d0!
  135.  
  136. RTS
  137. ;**********************
  138.  
  139. Runerrson
  140. .SkipSMR
  141.  
  142. Function.b CheckLib{Lib$,LibVer}
  143. ;Returns wether a specific library is available or not
  144.   *lib.l=OpenLibrary_(&Lib$,LibVer)
  145.   If *lib
  146.     CloseLibrary_ *lib
  147.     Function Return True
  148.   Else
  149.     Function Return False
  150.   EndIf
  151. End Function
  152.  
  153. Function.b InitDisplay{Title$}
  154. ;Creates a display for AGA or Graphics-Card output
  155. ;Title$=The screen title (not displayed)
  156.   SHARED PrefDisplayWidth,PrefDisplayHeight,PrefDisplayBuffering
  157.   SHARED *ScrVP,PrefDisplayID,IsAGA,PlanarBuf(),CGFXAvail
  158.  
  159.   ;Setup a test screen
  160.   Dim ScrTags.TagItem(13)
  161.   Rect.Rectangle\MinX=0,0,320,240 ; For test
  162.   ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
  163.   ScrTags(1)\ti_Tag=#SA_Height,240; For test
  164.   ScrTags(2)\ti_Tag=#SA_Depth,8
  165.   ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  166.   ScrTags(4)\ti_Tag=#SA_Type,$F
  167.   ScrTags(5)\ti_Tag=#SA_Quiet,True
  168.   ScrTags(6)\ti_Tag=#SA_ShowTitle,False
  169.   ScrTags(7)\ti_Tag=#SA_Behind,True
  170.   ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
  171.   ScrTags(9)\ti_Tag=#SA_Exclusive,False
  172.   ScrTags(10)\ti_Tag=#SA_Draggable,False
  173.   ScrTags(11)\ti_Tag=#SA_AutoScroll,False
  174.   ScrTags(12)\ti_Tag=#TAG_DONE,0
  175.   ScrTags(13)\ti_Tag=#TAG_DONE,0
  176.  
  177.   If CGFXAvail
  178.     IsAGA=1-(IsCyberModeID_(PrefDisplayID))
  179.   Else
  180.     ; Need to do a test
  181.     UsedChip.l=320*240 ; With test params (depth 8)
  182.     FreeChip.l=AvailMem_(#MEMF_CHIP)
  183.     Forbid_
  184.     If ScreenTags(0,Title$,&ScrTags(0))
  185.       NowChip.l=AvailMem_(#MEMF_CHIP)
  186.       Permit_
  187.       If FreeChip-NowChip<UsedChip
  188.         IsAGA=False
  189.       Else
  190.         IsAGA=True
  191.       EndIf
  192.       VWait 5
  193.       Free Screen 0
  194.       VWait 5
  195.     Else
  196.       ; Failed to open, so resort to fixed AGA LowRes
  197.       Permit_
  198.       IsAGA=True
  199.       PrefDisplayID=0
  200.       PrefDisplayWidth=320
  201.       PrefDisplayHeight=240
  202.     EndIf
  203.   EndIf
  204.  
  205.   If IsAGA
  206.     PrefDisplayWidth AND $FFC0 ; Multiples of 64 for AGA
  207.   Else
  208.     PrefDisplayWidth AND $FFF0 ; Multiples of 16 for graphics card
  209.   EndIf
  210.   ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
  211.   Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
  212.   ScrTags(8)\ti_Tag=#SA_DClip,&Rect
  213.  
  214.   If IsAGA
  215.     ; AGA display
  216.     ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
  217.     ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
  218.     Forbid_
  219.     For Loop.w=0 To PrefDisplayBuffering-1
  220.       If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  221.       If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
  222.         Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chipram bitmap
  223.         Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
  224.         If Memory
  225.           CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,8,Memory ; Depth 8
  226.           If Loop=0
  227.             ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
  228.             If ScreenTags(0,Title$,&ScrTags(0))=0
  229.               Permit_
  230.               Function Return False
  231.             EndIf
  232.           EndIf
  233. If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  234.           Menus Off
  235.         Else
  236.           Permit_
  237.           Function Return False
  238.         EndIf
  239.       Else
  240.         Permit_
  241.         Function Return False
  242.       EndIf
  243.       PlanarBuf(Loop)=Memory
  244.     Next Loop
  245.     Permit_
  246.   Else
  247.     ; Graphics-card display
  248.     ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
  249.     If ScreenTags(0,Title$,&ScrTags(0))
  250.       For Loop.w=0 To PrefDisplayBuffering-1
  251.         If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
  252. If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
  253.         Menus Off
  254.         ScreensBitMap 0,Loop
  255.         *TmpBmp.bitmap=Addr BitMap(Loop)
  256.         Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
  257.         For DLoop.w=0 To 8-1 ; Depth of 8
  258.           *TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
  259.         Next DLoop
  260.       Next Loop
  261.     Else
  262.       Function Return False
  263.     EndIf
  264.   EndIf
  265.  
  266.   If Peek.l(Addr Screen(0))
  267.     DEFTYPE.DimensionInfo DimInfoBuf
  268.     GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
  269.     PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
  270.     PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
  271.     *Scr._Screen=Peek.l(Addr Screen(0))
  272.     *ScrVP=ViewPort(0)
  273.     *ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
  274.     ScrollVPort_ *ScrVP
  275.     RethinkDisplay_
  276.     Menus Off
  277.     If *ScrVP\DHeight<>PrefDisplayHeight
  278.       Forbid_
  279.       *Scr\Height=PrefDisplayHeight ; Enforce y clipping
  280.       Permit_
  281.     EndIf
  282.     ScreenToFront_ *Scr
  283.     Function Return True
  284.   Else
  285.     Function Return False
  286.   EndIf
  287. End Function
  288.  
  289. .Main
  290. CGFXAvail.b=CheckLib{"cybergraphics.library",0}
  291. If CGFXAvail=False AND PrefDisplayMethod=2 Then PrefDisplayMethod=0
  292. InitPalette 0,256
  293. For c=1 To 255 : AGAPalRGB 0,c,Rnd(255),Rnd(255),Rnd(255) : Next c
  294. If InitDisplay{"Game"}=False Then Goto Finish
  295. InitBank 0,320*240,$10000
  296. CludgeBitMap 4,320,240,8,Bank(0)
  297. LoadBitMap 4,"Rain.256",0
  298. LoadRGB32_ *ScrVP,Peek.l(Addr Palette(0))
  299. If PrefDisplayMethod=0 AND OSVersion<40
  300.   MBitmap 5,PrefDisplayWidth,PrefDisplayHeight ; Temporary bitmap to allow WPA8 instead of WPL8's
  301. EndIf
  302.  
  303. MBitmap 0,PrefDisplayWidth,PrefDisplayHeight
  304. If IsAGA Then Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight
  305. MPlanar16ToBitmap 0,Bank(0),320,240,320,240
  306.  
  307. .Table
  308. ;Set up movement table
  309. #Objects=5000
  310. Dim pnt.l(#Objects)
  311. Dim direction.l(#Objects)
  312. Dim old.b(#Objects)
  313. For obj=0 To #Objects-1 Step 4
  314.   pnt(obj)=MBitmapPtr(0)+Rnd(PrefDisplayWidth-1)+(Rnd(PrefDisplayHeight-1)*MBitmapWidth(0))
  315.   r=Rnd(6)
  316.   direction(obj)=((r+6)*MBitmapWidth(0))+2
  317.   pnt(obj+1)=pnt(obj)-MBitmapWidth(0)
  318.   direction(obj+1)=direction(obj)
  319.   pnt(obj+2)=pnt(obj)-(MBitmapWidth(0)*2)-1
  320.   direction(obj+2)=direction(obj)
  321.   pnt(obj+3)=pnt(obj)-(MBitmapWidth(0)*3)-1
  322.   direction(obj+3)=direction(obj)
  323. Next obj
  324.  
  325. .Loop
  326. buf.b=0
  327. its.l=0
  328. cnt.b=0
  329. MParticleFormat 1
  330. ResetTimer
  331. While Joyb(0)<>1 AND Joyb(1)=0
  332.  
  333.   If Joyb(0)=2 Then VWait
  334.  
  335.   MAddToParticles &pnt(0),#Objects,&direction(0)
  336.   MWrapParticles &pnt(0),#Objects
  337.   MGrabParticlesAndPlot &pnt(0),#Objects,&old(0),100;7;11
  338.  
  339.   ;Display
  340.   If IsAGA
  341.     Mc2p MBitmapPtr(0),PlanarBuf(buf)
  342.     If PrefDisplayBuffering>1
  343.       ShowBitMap buf
  344.       buf+1
  345.       If buf=PrefDisplayBuffering Then buf=0
  346.     EndIf
  347.   Else
  348.     *RP0._RastPort=RastPort(0)
  349.     Select PrefDisplayMethod
  350.  
  351.       Case 0 ; WritePixelArray8
  352.       If PrefDisplayBuffering>1
  353.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  354.         If OSVersion<40
  355.           MUseBitmap 5
  356.           MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
  357.           MUseBitmap 0
  358.           WritePixelArray8_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
  359.         Else
  360.           WriteChunkyPixels_ *RP1,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
  361.         EndIf
  362.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  363.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  364.       Else
  365.         If OSVersion<40
  366.           MUseBitmap5
  367.           MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From window in modulo bitmap, to nonmodulo bitmap
  368.           MUseBitmap 0
  369.           WritePixelArray8_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(5),0
  370.         Else
  371.           WriteChunkyPixels_ *RP0,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),MBitmapWidth(0)
  372.         EndIf
  373.       EndIf
  374.  
  375.       Case 1 ; MBlockScroll
  376.       If CGFXAvail AND PrefCGFXLock
  377.         Dim CGFXTags.TagItem(1)
  378.         CGFXData.l=0
  379.         CGFXTags(0)\ti_Tag=#LBMI_BASEADDRESS,&CGFXData
  380.         CGFXTags(1)\ti_Tag=#TAG_DONE,0
  381.         LockHandle.l=LockBitMapTagList_(*RP0\_BitMap,&CGFXTags(0))
  382.         MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,CGFXData
  383.       Else
  384.         MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP0\_BitMap\Planes
  385.       EndIf
  386.       If PrefDisplayBuffering>1
  387.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  388.         MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight+(cnt*PrefDisplayHeight),0 ; From modulo bitmap
  389.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  390.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  391.       Else
  392.         MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0 ; From modulo bitmap
  393.       EndIf
  394.       MUseBitmap 0
  395.       If CGFXAvail AND (LockHandle<>0) AND PrefCGFXLock Then UnLockBitMap_ LockHandle
  396.  
  397.       Case 2 ; CGFXWriteChunkyPixels
  398.       If PrefDisplayBuffering>1
  399.         *RP1._RastPort=RastPort(Min(PrefDisplayBuffering-1,cnt+1))
  400.         WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP1,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
  401.         ClipBlit_ *RP1,0,0,*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,$C0
  402.         If PrefDisplayBuffering=3 Then cnt=1-cnt ; Toggle output buffer
  403.       Else
  404.         WritePixelArray_ MBitmapPtr(0),0,0,MBitmapWidth(0),*RP0,0,0,PrefDisplayWidth,PrefDisplayHeight,#RECTFMT_LUT8
  405.       EndIf
  406.     End Select
  407.   EndIf
  408.  
  409.   MDrawParticles &pnt(0),#Objects,&old(0)
  410.  
  411.   its+1
  412. Wend
  413.  
  414. ;Report
  415. t=Timer
  416. t=Max(t,1)
  417. its=Max(its,1)
  418. a.q=50.0/(t/its)
  419. WBenchToFront_
  420. WbToScreen 1
  421. Window 2,16,16,300,40,0,"Test results",1,0
  422. WindowOutput 2
  423. NPrint a," frames per second"
  424. NPrint " "
  425. NPrint "Press mouse/joy button..."
  426. VWait 20
  427. Repeat
  428. Until Joyb(0)<>0 OR Joyb(1)<>0
  429.  
  430. Finish:
  431. End
  432.  
  433.